home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / shells / scsh-0.4 / scsh-0 / scsh-0.4.2 / emacs / jar-hacks.el < prev    next >
Lisp/Scheme  |  1995-10-13  |  3KB  |  92 lines
  1.  
  2. ; Comment out region
  3.  
  4. (defun comment-out-region (arg)
  5.   "Insert comment string at beginning of each line in the region."
  6.   (interactive "P")
  7.   (let (start end)
  8.     (if (< (point) (mark))
  9.         (setq start (point) end (mark-marker))
  10.         (setq start (mark) end (point-marker)))
  11.     (save-excursion
  12.       (untabify start (marker-position end))
  13.       (goto-char start)
  14.       (if (not (bolp))
  15.       (progn (end-of-line) (forward-char)))
  16.       (while (< (point) (marker-position end))
  17.     (if (eq arg '-)
  18.         (if (looking-at comment-start)
  19.         (delete-char (length comment-start)))
  20.         (insert comment-start))
  21.     (end-of-line)
  22.     (forward-char)))))
  23.  
  24. ;(defun uncomment-out-region (arg)
  25. ;  (interactive nil)
  26. ;  (comment-out-region '-))
  27.  
  28.  
  29. ; Mini-Find Tag
  30.  
  31. (defvar last-mini-tag "" "Last tag sought by mini-find-tag.")
  32.  
  33. (defun mini-find-tag (tagname &optional next)
  34.   "Search for a definition of TAGNAME in current buffer.
  35.  If TAGNAME is a null string, the expression in the buffer
  36. around or before point is used as the tag name.
  37.  If second arg NEXT is non-nil (interactively, with prefix arg),
  38. searches for the next definition in the buffer
  39. that matches the tag name used in the previous mini-find-tag."
  40.  
  41.   (interactive (if current-prefix-arg
  42.            '(nil t)
  43.          (list (read-string "Mini-find tag: "))))
  44.   (if (equal tagname "")             ;See definition of find-tag.
  45.       (setq tagname (save-excursion
  46.               (buffer-substring
  47.                (progn (backward-sexp 1) (point))
  48.                (progn (forward-sexp 1) (point))))))
  49.   (let ((pt (save-excursion
  50.           (if (not next)
  51.           (goto-char (point-min))
  52.         (setq tagname last-mini-tag))
  53.           (setq last-mini-tag tagname)
  54.           (if (re-search-forward
  55.              (concat "^(def.*" tagname)
  56.              nil t)
  57.           (point)
  58.         nil))))
  59.     (if pt
  60.     (progn (set-mark-command nil)
  61.            (goto-char pt))
  62.       (signal 'search-failed '()))))
  63.  
  64. ; indent-differently
  65.  
  66. (defun indent-differently ()
  67.   "Make the current line indent like the body of a special form by
  68. changing the operator's scheme-indent-hook appropriately."
  69.   (interactive nil)
  70.   (let ((here (point)))
  71.     (save-excursion
  72.       (back-to-indentation)
  73.       (backward-up-list 1)
  74.       (forward-char 1)
  75.       (let ((i -1)
  76.         (function nil)
  77.         (p (point)))
  78.     (while (<= (point) here)
  79.       (setq i (+ i 1))
  80.       (forward-sexp 1)
  81.       (if (= i 0)
  82.           (setq function (buffer-substring p (point)))))
  83.     (setq i (- i 1))
  84.     (let ((name (intern (downcase function))))
  85.       (cond ((equal (get name 'scheme-indent-hook) i)
  86.          (message "Indent %s nil" name)
  87.          (put name 'scheme-indent-hook nil))
  88.         (t
  89.          (message "Indent %s %d" name i)
  90.          (put name 'scheme-indent-hook i))))))
  91.     (scheme-indent-line)))
  92.